# TODO: Add comment
# 
# Author: Roger
###############################################################################

setClass("GBSOption",
		contains=c(
				"OptionType",
				"Underlying",
				"Quantity",
				"Strike",
				"SituationDate",
				"MaturityDate",
				"Currency",
				"Name",
				"Exchange",
				"Price",
				"ImpliedVolatility",
				"RiskFreeRate",
				"CostOfCarryRate",
				"UnderlyingValue"
				)
)

GBSOption <- function(OptionType,Underlying,Quantity,Strike,SituationDate,MaturityDate,Currency,Name,Exchange){
	new("GBSOption",OptionType=OptionType,Underlying=Underlying,Quantity=Quantity,Strike=Strike,SituationDate=SituationDate,MaturityDate=MaturityDate,Currency=Currency,Name=Name,Exchange=Exchange)
}

# x <- object <- GBSOption("c","SMI",1,6000,Sys.Date(),Sys.Date()+100,"CHF","SMI Option","EUREX")

setMethod("show","GBSOption",function(object){
			Type <- c("Call","Put")[c(optionType(object)=="c",optionType(object)=="p")]
			cat("European ",Type," Option as of ",situationDate.character(object),"\n",sep="")
			cat("Underlying: ",underlying(object),"\n",sep="")
			cat("Currency: ",currency(object),"\n",sep="")
			cat("Strike: ",strike(object),"\n",sep="")
			cat("Quantity: ",quantity(object),"\n",sep="")
			cat("Maturity Date: ",maturityDate.character(object),"\n",sep="")
		})

optionPayOut <- function(object,UnderlyingValue){
	if(optionType(object)=="c"){
		payOut <- UnderlyingValue - strike(object)
		payOut[payOut<0] <- 0
	}
	if(optionType(object)=="p"){
		payOut <- strike(object) - UnderlyingValue
		payOut[payOut<0] <- 0
	}
	payOut * quantity(object)
}

setMethod("presentValue",signature=c("GBSOption","numeric"),function(object,arg1){
			# Hull Chapter 15 Page 323
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			if(Time>0){
				d1 <- (log(S/K) + (r - q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
				d2 <- d1 - sigma * sqrt(Time)
				if (TypeFlag == "c"){
					result <- S * exp(-q * Time) * pnorm(d1) - K * exp(-r * Time) * pnorm(d2)
				}
				if (TypeFlag == "p"){
					result <- K * exp(-r * Time) * pnorm(-d2) - S * exp(-q * Time) * pnorm(-d1)
				}
				pv <- result * quantity(object)	
			}else{
				pv <- optionPayOut(object,arg1)
			}
			pv
		})

setMethod("presentValue",signature=c("GBSOption","missing"),function(object,arg1){
			presentValue(object,underlyingValue(object))
		})

setMethod("presentValue",signature=c("GBSOption","DiscountFactor"),function(object,arg1){
			riskFreeRate(object) <- as.numeric(getData(as.ZeroRateCurve(arg1)[maturityDate(object)]))
			presentValue(object)
		})

calculateImpliedVolatility <- function(object,UnderlyingValue){
	MarketValue <- price(object) * quantity(object)
	f <- function(sigma){
		impliedVolatility(object) <- sigma
		MarketValue - presentValue(object,UnderlyingValue)
	}
	ImpliedVolatility <- uniroot(f,c(0.000001,1000),maxiter=10000)$root
	ImpliedVolatility
}

setMethod("plot",signature("GBSOption"),function(x,y,...){
			
			UnderlyingValue <- seq(0.8,1.2,length.out=21) * strike(x)
			optionPrice <- price(x)
			optionPrice[length(optionPrice)==0] <- 0
			optionQuantity <- quantity(x)
			
			CalcDate <- seq(situationDate(x),maturityDate(x),length.out=4)
			nCalcDate <- length(CalcDate)
			ScenCalc <- sapply(1:nCalcDate,function(i,x){
						situationDate(x) <- CalcDate[i]
						sapply(UnderlyingValue,function(uv,object)presentValue(object,uv),x)
					},x)-optionPrice * quantity(x)
			
			#payOut <- optionPayOut(x,UnderlyingValue)-optionPrice * quantity(x)
			Type <- c("Call","Put")[c(optionType(x)=="c",optionType(x)=="p")]
			LongShort <- c("Short","Long")[c(quantity(x)<0,quantity(x)>0)]
			PlotTitle <- paste(underlying(x)," ",LongShort," ",Type," Option\nStrike: ",strike(x),"\nMaturity Date:",maturityDate.character(x),sep="")
			plot(UnderlyingValue,ScenCalc[,nCalcDate],type="l",lwd=3,main=PlotTitle,ylab="Final Pay Out",xlab=underlying(x))
			for(i in 1:(nCalcDate-1))
				lines(UnderlyingValue,ScenCalc[,i],lwd=2,col=i+1)
			abline(h=0,v=strike(x),lty=2)
			LegendAlign <- c("topleft","bottomleft","topright","bottomright")[c(Type=="Call" & optionQuantity > 0,Type=="Call" & optionQuantity < 0,Type=="Put" & optionQuantity > 0,Type=="Put" & optionQuantity < 0)]
			legend(LegendAlign,as.character(CalcDate),col=c(2:(nCalcDate),1),lwd=c(rep(2,nCalcDate),3))
			#plot(UnderlyingValue,payOut,type="l",lwd=3,main=PlotTitle,ylab="Final Pay Out",xlab=underlying(x))
					
		})

setMethod("delta",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 <- (log(S/K) + (r - q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			if (TypeFlag == "c") 
				result <- exp(-q * Time) * pnorm(d1)
			if (TypeFlag == "p") 
				result <- -exp(-q * Time) * (pnorm(-d1))
			result * quantity(object)
		})

setMethod("gammma",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 <- (log(S/K) + (r - q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			result <- exp(-q * Time) * dnorm(d1)/(S * sigma * sqrt(Time))
			result * quantity(object)
		})

setMethod("deltagamma01",signature=c("GBSOption","numeric"),function(object,arg1){
			delta(object,arg1) + 1/2*gammma(object,arg1)
		})

setMethod("deltagamma01empirical",signature=c("GBSOption","numeric"),function(object,arg1){
			presentValue(object,arg1+1) - presentValue(object,arg1)
		})

setMethod("theta",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 <- (log(S/K) + (r - q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			d2 <- d1 - sigma * sqrt(Time)
			Theta1 <- -(S * exp(-q * Time) * dnorm(d1) * sigma)/(2 * sqrt(Time))
			if (TypeFlag == "c") 
				result <- Theta1 - (-q) * S * exp(-q * Time) * pnorm(d1) - r * K * exp(-r * Time) * pnorm(d2)
			if (TypeFlag == "p") 
				result <- Theta1 + (-q) * S * exp(-q * Time) * pnorm(-d1) + r * K * exp(-r * Time) * pnorm(-d2)
			result * quantity(object)
		})

setMethod("vega",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 = (log(S/K) + (r - q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			result = S * exp(-q * Time) * dnorm(d1) * sqrt(Time)
			result * quantity(object)/100
		})

setMethod("vomma",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 = (log(S/K) + (r-q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			d2 = d1 - sigma * sqrt(Time)
			vega(object,arg1)*d1*d2/sigma
		})

setMethod("vegavomma01",signature=c("GBSOption","numeric"),function(object,arg1){
			vega(object,arg1)*0.01 +1/2 * vomma(object,arg1) * 0.01^2
		})

setMethod("vegavomma01empirical",signature=c("GBSOption","numeric"),function(object,arg1){
			object2 <- object
			impliedVolatility(object2) <- impliedVolatility(object) + 0.01
			presentValue(object2,arg1) - presentValue(object,arg1)
		})

setMethod("rho",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 <- (log(S/K) + (r-q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			d2 <- d1 - sigma * sqrt(Time)
			CallPut <- presentValue(object,arg1) * quantity(object)
			if (TypeFlag == "c") {
				if (r-q != 0) {
					result <- Time * K * exp(-r * Time) * pnorm(d2)
				}
				else {
					result <- -Time * CallPut
				}
			}
			if (TypeFlag == "p") {
				if (r-q != 0) {
					result <- -Time * K * exp(-r * Time) * pnorm(-d2)
				}
				else {
					result <- -Time * CallPut
				}
			}
			result * quantity(object)/100
		})

setMethod("rho2",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 <- (log(S/K) + (r-q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			d2 <- d1 - sigma * sqrt(Time)
			CallPut <- presentValue(object,arg1) * quantity(object)
			if (TypeFlag == "c") {
				if (r-q != 0) {
					result <- -Time^2 * K * exp(-r * Time) * pnorm(d2)
				}
				else {
					result <- Time^2 * CallPut
				}
			}
			if (TypeFlag == "p") {
				if (r-q != 0) {
					result <- Time^2 * K * exp(-r * Time) * pnorm(-d2)
				}
				else {
					result <- Time^2 * CallPut
				}
			}
			result * quantity(object)/100^2
		})

setMethod("dv01",signature=c("GBSOption","numeric"),function(object,arg1){
			rho(object,arg1)*0.01 + 1/2 * rho2(object,arg1) * 0.01^2
		})

setMethod("dv01",signature=c("GBSOption","DiscountFactor"),function(object,arg1){
			riskFreeRate(object) <- as.numeric(getData(as.ZeroRateCurve(arg1)[maturityDate(object)]))
			rho(object,underlyingValue(object))*0.01 + 1/2 * rho2(object,underlyingValue(object)) * 0.01^2
		})

setMethod("dv01empirical",signature=c("GBSOption","numeric"),function(object,arg1){
			object2 <- object
			riskFreeRate(object2) <- riskFreeRate(object) + 0.01
			presentValue(object2,arg1) - presentValue(object,arg1)
		})
		
setMethod("rhoCoC",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 <- (log(S/K) + (r-q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			if (TypeFlag == "c") 
				result <- Time * S * exp(-q * Time) * pnorm(d1)
			if (TypeFlag == "p") 
				result <- -Time * S * exp(-q * Time) * pnorm(-d1)
			result * quantity(object)/100	
		})

setMethod("rhoCoC2",signature=c("GBSOption","numeric"),function(object,arg1){
			TypeFlag <- optionType(object)
			K <- strike(object)
			S <- arg1
			sigma <- impliedVolatility(object) / 100
			q <- costOfCarryRate(object) / 100
			r <- riskFreeRate(object) / 100
			Time <- yearFraction(situationDate(object),maturityDate(object))
			d1 <- (log(S/K) + (r-q + sigma * sigma/2) * Time)/(sigma * sqrt(Time))
			if (TypeFlag == "c") 
				result <- -Time^2 * S * exp(-q * Time) * pnorm(d1)
			if (TypeFlag == "p") 
				result <- Time^2 * S * exp(-q * Time) * pnorm(-d1)
			result * quantity(object)/100	
		})


		
		
		
